home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Programming Tools / Pascal Demos from Apple / print / PRINT.TEXT next >
Encoding:
Text File  |  1985-04-30  |  59.0 KB  |  1,850 lines  |  [TEXT/ttxt]
  1. {$X-}   {Turn off stack expansion. This is a Lisa concept, not needed on Mac}
  2. {$U-}   {Turn off the Lisa Libraries. This is required by the WorkShop}
  3. {$R-}   {Turn off range checking}
  4.  
  5. Program LaserPrinting;
  6.  
  7. (*
  8.  --   Jeffery J. Bradford,  Macintosh Technical Support, Jan 1985
  9.  --
  10.  -- This is a printing example which demonstrates how to print using
  11.  -- the Printing Manager. To use the calls of the Printing Manager
  12.  -- link with obj/PrLink.obj.
  13.  --
  14.  -- This program was written to test out printing cases for the LaserWriter.
  15.  -- If you want to use it to test your own stuff, add the procedure and
  16.  -- call it from the menu list. (see how the program works - its simple).
  17.  -- To print just put your procedure into the Case statement in the Print loop.
  18.  --
  19.  -- The printer dialogs are in a separate menu so you can set up the
  20.  -- format any way you want and then choose Printing Operation from
  21.  -- another menu. Also, be sure to select the desired font, style, and
  22.  -- text size before selecting the print menu item.
  23.  --
  24.  -- If you follow the steps below, your code should print on the Imagewriter
  25.  -- as well as the LaserWriter without any problem.
  26.  --
  27.  --         0. Link with obj/prLink.obj.
  28.  --         0. include {$U Obj/MacPrint  } MacPrint;  in the USES statment.
  29.  --
  30.  --         1. PrOpen       to open the Printing Mgr resource file.
  31.  --         2. PrintDefault to set the initial default settings
  32.  --         2a PrValidate   to set the initial default settings also
  33.  --
  34.  --    now you are ready to print:
  35.  --         3. PrOpenDoc    to open the printing grafport.
  36.  --         4. PrOpenPage   to setup a new page up for printing.
  37.  --         5. Draw into printer port whatever you want printed.
  38.  --         6. PrClosePage  to finish the current page print
  39.  --         7. PrCloseDoc   to close and dealocate the printing grafport.
  40.  --
  41.  --    now you are finished printing
  42.  --         8. PrClose      to close the Printing Mgr resource file
  43.  --
  44.  --
  45.  *)
  46.  
  47. USES
  48.     {$U Obj/Memtypes  } MemTypes,
  49.     {$U Obj/QuickDraw } QuickDraw,
  50.     {$U Obj/OSIntf    } OSIntf,
  51.     {$U Obj/ToolIntf  } ToolIntf,
  52.     {$U Obj/PackIntf  } PackIntf,
  53.     {$U Obj/MacPrint  } MacPrint;
  54.  
  55. CONST
  56.     Bit7      = 7;
  57. {menu stuff}
  58.     AppleMenu = 256;
  59.     PrintMenu = 257;
  60.     FontMenu  = 258;
  61.     StyleMenu = 259;
  62.     PrDlogMenu= 260;
  63.     PrDrvrMenu= 261;
  64.     PicScrMenu= 262;
  65.  
  66. {print tests for Pr Mgr only}
  67.     PrDrawPicture = 1;
  68.     PrMakeQDCalls = 2;
  69.     PrFramePage   = 3;
  70.     PrFrameText   = 4;
  71.     PrUseTextBox  = 5;
  72.     PrBitMap      = 6;
  73.     PrChkSetOrig  = 7;
  74.     PrChkPicComm  = 8;
  75.     PrRotateTex   = 9;
  76.     PrFineGrid    = 10;
  77.     PrSmothPloy   = 11;
  78.  
  79. {devices}
  80.     theScreen  = 0;
  81.     theImageW  = 1;
  82.     theDaisyW  = 2;
  83.     theLaserW  = 3;
  84.  
  85. {picture comment constants}
  86.     TextBegin = 150;
  87.     TextEnd   = 151;
  88.     TextCenter= 154;
  89.  
  90.     PolyBegin = 160;
  91.     PolyEnd   = 161;
  92.     PolyIgnore= 163;
  93.     PolyVerb  = 164;
  94.  
  95. {window & dialog resource IDs}
  96.     WindResID = 257;
  97.  
  98.  
  99.  
  100. TYPE
  101.     IconData = Array[0..95] of integer;
  102.  
  103.     GetStuff = Packed Record
  104.        Case Integer of
  105.         0: (a0: Integer);
  106.         1: (b1,b0: SignedByte);
  107.         2: (f15,f14,f13,f12,f11,f10,f9,f8,f7,f6,f5,f4,f3,f2,f1,f0: Boolean)
  108.        End;
  109.  
  110.     LMwordPtr = ^Integer;          {pointer to low memory address}
  111.  
  112.  
  113. VAR
  114. {bit map stuff}
  115.     icons: Array[0..5] of IconData; {store 6 icons in here}
  116.     whichIcon:    integer;          {holds icon ID number}
  117.     QDPicture:    PicHandle;        {handle to the QD Picture}
  118.  
  119. {global program stuff}
  120.     Finished:      Boolean;    {used to terminate the program}
  121.     ClockCursor:   CursHandle; {handle to the waiting watch cursor}
  122.  
  123. {font stuff}
  124.     CurntFontID:   Integer;   {holds the currently selected text font}
  125.     CurntStyleID:  Style;     {holds the currently selected text style}
  126.     CurntSizeID:   Integer;   {holds the currently selected text size}
  127.     PrevFontChked: Integer;   {holds the previously slected font}
  128.  
  129. {printer stuff}
  130.     PrRecordHdl:   THPrint;   {handle to the print record}
  131.     PrPortStorage: TPrPort;   {storage for the printer grafport}
  132.     PrintPort:     TPPrPort;  {pointer to the printers grafport}
  133.     DefaltPage:    Rect;      {holds the currently selected printer page size}
  134.     CurPrTest:     Integer;   {holds the value to the current drawing routine}
  135.     PrDlgPtr:      DialogPtr; {pointer to the cancel/pause dialog}
  136.     PrStopDlgRec:DialogRecord;{record for the cance/pause dialog}
  137.  
  138. {window stuff}
  139.     DragArea,                 {holds the area where window can be dragged in}
  140.     GrowArea,                 {holds the area to which a window's size can change}
  141.     Screen:     Rect;         {holds the screen dimensions}
  142.     aWindow:    WindowPtr;    {pointer to text window}
  143.  
  144. {-----------------------------------------------------------------------------
  145.                      end of global variable definition
  146. -----------------------------------------------------------------------------}
  147.  
  148. {The following procedures contain printing code to: Print text, print graphics,}
  149. {print a bitmap, print the screen, and test out weird things developers do}
  150.  
  151. {-----------------------------------------------------------------------------}
  152.  
  153. {                     Printing Manager Procedures                             }
  154.  
  155. PROCEDURE FramePage     (Where: integer);               FORWARD;
  156. PROCEDURE PrintBitMap   (Where: integer);               FORWARD;
  157. PROCEDURE MakeQDCalls   (where:integer);                FORWARD;
  158. PROCEDURE ShowAllQDCalls(Where:integer);                FORWARD;
  159. PROCEDURE BuildQDPicture(where:integer);                FORWARD;
  160. PROCEDURE ShowQDPic     (Where:integer);                FORWARD;
  161. PROCEDURE UseTextBox    (Where: Integer);               FORWARD;
  162. PROCEDURE FrameText     (Where: Integer);               FORWARD;
  163. PROCEDURE PrintLables   (Where: Integer);               FORWARD;
  164. PROCEDURE PrintText     (Where: Integer);               FORWARD;
  165. PROCEDURE PrintRotText  (Where: Integer);               FORWARD;
  166. PROCEDURE PrintFineGrid (Where: Integer);               FORWARD;
  167. PROCEDURE PrintPolygon  (Where: Integer);               FORWARD;
  168.  
  169.  
  170. {                     Printer Driver Procedures                             }
  171. PROCEDURE PutPicScrap;                                  FORWARD;
  172. PROCEDURE PrDrBitMap;                                   FORWARD;
  173. PROCEDURE PrDrScr_wEvtCtl;                              FORWARD;
  174. PROCEDURE PrDrScrBitMap;                                FORWARD;
  175. PROCEDURE PrDrStreamText;                               FORWARD;
  176. PROCEDURE PrDrPostScript;                               FORWARD;
  177.  
  178. {-----------------------------------------------------------------------------}
  179.  
  180. PROCEDURE SetPrDialog(Printer: Integer);
  181. Var IType: Integer;
  182.     IHdl:  Handle;
  183.     IRect: Rect;
  184. Begin
  185.   PrDlgPtr := GetNewDialog(257, @PrStopDlgRec, Pointer(-1));
  186.  
  187. {disable the continue item to start with}
  188.   GetDItem(PrDLgPtr, 3, Itype, IHdl, IRect);   {get the item}
  189.   HiliteControl(ControlHandle(IHdl), 255);     {disable it}
  190.  
  191. {if its the laser disable the pause item}
  192.   If Printer = theLaserW then
  193.   begin
  194.     GetDItem(PrDLgPtr, 2, Itype, IHdl, IRect);   {get the item}
  195.     HiliteControl(ControlHandle(IHdl), 255);     {disable it}
  196.   end;
  197.  
  198.   DrawDialog(PrDlgPtr);
  199. End;
  200.  
  201. {-----------------------------------------------------------------------------}
  202.  
  203. PROCEDURE ChkForCanceOrPause;
  204. Var ProcessIt: Boolean;
  205.     itemHit:   Integer;
  206.     itemHdl:   Handle;
  207.     itemRect:  Rect;
  208.     Event:     EventRecord;
  209.     DlgPtr:    DialogPtr;
  210.  
  211. Begin
  212.   ProcessIt := GetNextEvent(EveryEvent, Event);
  213.   If IsDialogEvent(Event) then
  214.     If DialogSelect(Event, DlgPtr, ItemHit) then
  215.       Case itemHit of
  216.         1: PrSetError(iPrAbort);
  217.         2: begin end; {pause enable continue disable pause go into repeat loop}
  218.         3: begin end; {continue and enable pause}
  219.       End;
  220. End;
  221.  
  222. {-----------------------------------------------------------------------------}
  223.  
  224. PROCEDURE PrintIt(PrintWhat: Integer);
  225. Var
  226.     numCopies:   Integer;      {holds the number of copies the user wants}
  227.     Count:       Integer;      {used to count number of copies}
  228.     TempPort:    GrafPtr;      {holds the current port while printport is used}
  229.     Status:      TPrStatus;    {record for status while spool printing occors}
  230.     dummy:       boolean;      {just a dummy boolean for function assignment}
  231.     thePrinter:  integer;      {ID of the type of printer}
  232.  
  233. Begin
  234.  
  235. {get the current port & save it}
  236.     GetPort(TempPort);
  237.  
  238. {get the type of printer we are printing to}
  239.     thePrinter:= GetStuff(PrRecordHdl^^.PrStl.wDev).b1;
  240.  
  241. {If current test is picture then create it}
  242.     If CurPrTest = PrDrawPicture then
  243.       BuildQDPicture(thePrinter);
  244.  
  245. {set our idleproc to handle aborts & pauses; Setup the Dialog also}
  246.     PrRecordHdl^^.prJob.pIdleProc := @ChkForCancelOrPause;
  247.     SetPrDialog(thePrinter);
  248.  
  249. {open up the printer port, port is set automaticly}
  250.     PrintPort := PrOpenDoc(PrRecordHdl, @PrPortStorage, Nil);
  251.  
  252. {loop on the number of copies}
  253.     numCopies := PrRecordHdl^^.prJob.iCopies;
  254.     For count := 1 to numCopies do
  255.     begin
  256.        PrOpenPage(PrintPort, Nil);    {Nil= do not scale the drawing}
  257.  
  258.          Case CurPrTest of
  259.            PrDrawPicture: ShowQDPic     (thePrinter);  {1}
  260.            PrMakeQDCalls: ShowAllQDCalls(thePrinter);  {2}
  261.            PrFramePage:   FramePage     (thePrinter);  {3}
  262.            PrFrameText:   FrameText     (thePrinter);  {4}
  263.            PrUseTextBox:  UseTextBox    (thePrinter);  {5}
  264.            PrBitMap:      PrintBitMap   (thePrinter);  {6}
  265.            PrChkSetOrig:  PrintLables   (thePrinter);  {7}
  266.            PrChkPicComm:  PrintText     (thePrinter);  {8}
  267.            PrRotateTex:   PrintRotText  (thePrinter);  {9}
  268.            PrFineGrid:    PrintFineGrid (thePrinter);  {10}
  269.            PrSmothPloy:   PrintPolygon  (thePrinter);  {11}
  270.          End;
  271.  
  272.        PrClosePage(PrintPort);
  273.     end;
  274.  
  275.     PrCloseDoc(PrintPort);   {close PrGrafport}
  276.     SetPort(TempPort);       {Reset the port}
  277.  
  278. {If spooling was selected, print the file now}
  279.     If (PrRecordHdl^^.PrJob.bJDocLoop = bSpoolLoop) AND (PrError=0)
  280.     then PrPicFile(PrRecordHdl,@PrPortStorage, NIL, NIL, Status);
  281.  
  282. {get rid of Cancel dialog}
  283.    CloseDialog(PrDlgPtr);
  284. End;
  285.  
  286. {-----------------------------------------------------------------------------}
  287.  
  288. {AAA}
  289. {The procedures below print directly to the Driver}
  290.  
  291.  
  292. PROCEDURE PrDrBitMap;
  293. {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
  294. {here only to test the Driver without Pr Manager interference}
  295. Var
  296.     srcBits   : BitMap;
  297.     srcRect   : Rect;
  298.  
  299. Begin
  300.   PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }
  301.  
  302.   srcBits.baseAddr:=@icons[0];            {set start address for icon data}
  303.   srcBits.rowBytes:=6;                   {set 6 as # of bytes per row}
  304.   SetRect(srcBits.bounds,0,0,48,32);     {48 X 32 pixels = 6 X 4 bytes}
  305.  
  306.   PrDRvrOpen;  {not needed if PrOpen has been called}
  307.   PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  308.   PrCtlCall(iPrBitsCtl, Ord(@srcBits), Ord(@SrcBits.bounds), 1);
  309.   PrDrvrClose;
  310.  
  311.   PROPEN;  {open up the Printing Manager again}
  312. End;
  313.  
  314. {-----------------------------------------------------------------------------}
  315.  
  316. PROCEDURE PrDrScr_wEvtCtl;
  317. {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
  318. {here only to test the Driver without Pr Manager interference}
  319. Begin
  320.   PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }
  321.  
  322.   PrDRvrOpen;  {not needed if PrOpen has been called}
  323.   PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  324.   PrCtlCall(iPrEvtCtl, lPrEvtAll, 0, 0);
  325.   PrDrvrClose;
  326.  
  327.   PROPEN;  {open up the Printing Manager again}
  328. End;
  329.  
  330. {-----------------------------------------------------------------------------}
  331.  
  332. PROCEDURE PrDrScrBitMap;
  333. {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
  334. {here only to test the Driver without Pr Manager interference}
  335.  
  336. Begin
  337.   PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }
  338.  
  339.   PrDRvrOpen;
  340.   PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  341.   PrCtlCall(iPrBitsCtl, Ord(@ScreenBits), Ord(@ScreenBits.bounds), 1);
  342.   PrDrvrClose;
  343.  
  344.   PROPEN;  {open up the Printing Manager again}
  345. End;
  346.  
  347. {-----------------------------------------------------------------------------}
  348.  
  349. PROCEDURE PrDrStreamText;
  350. {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
  351. {here only to test the Driver without Pr Manager interference}
  352.  
  353. Var TxT: Str255;
  354.     len: Integer;
  355.     lParam1: LongInt;
  356.  
  357. Begin
  358.   PRCLOSE;   {Only calls below needed, if going to directly to PrDriver }
  359.  
  360.   TextFont(CurntFontID);        {test changing the font}
  361.   TextFace(CurntStyleID);       {test changing the style}
  362.   TextSize(CurntSizeID);        {test changing the size}
  363.  
  364.   Txt := 'This is text streaming to the LaserWriter';
  365.   Len := Length(Txt);
  366.   lParam1 := $0003FFFF;
  367.  
  368.   PrDrvrOpen;
  369.   PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
  370.  
  371.   PrCtlCall(iPrIOCtl, LongInt(@Txt)+1, LongInt(Len), 0);
  372.   PrCtlCall(iPrDevCtl, lParam1, 0,0);
  373.  
  374.   PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
  375.   PrCtlCall(iPrDevCtl, lParam1, 0,0);
  376.  
  377.   PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
  378.   PrCtlCall(iPrDevCtl, lParam1, 0,0);
  379.  
  380.   PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
  381.   PrCtlCall(iPrDevCtl, lParam1, 0,0);
  382.  
  383.   PrCtlCall(iPrDevCtl, lPrPageEnd, 0, 0);
  384.   PrDrvrClose;
  385.  
  386.   PROPEN;  {open up the Printing Manager again}
  387. End;
  388.  
  389. {-----------------------------------------------------------------------------}
  390.  
  391. PROCEDURE PrDrPostScript;
  392. Begin
  393. End;
  394.  
  395. {-----------------------------------------------------------------------------}
  396.  
  397. {BBB}
  398. {the procedures below are used to draw into the Print Managers port}
  399.  
  400.  
  401. PROCEDURE InitDisplayArea(Where:integer; Var DisplayArea: Rect);
  402. Begin
  403.   If where = theScreen
  404.   then begin
  405.     SetPort(aWindow);                      {to be sure}
  406.     SetOrigin(0,0);                        {reset from previuos screwy stuff}
  407.     DisplayArea := aWindow^.portRect;
  408.     eraseRect(DisplayArea);
  409.   end
  410.   else DisplayArea := PrRecordHdl^^.prInfoPT.rPage;
  411. End;
  412.  
  413. {-----------------------------------------------------------------------------}
  414.  
  415. PROCEDURE FramePage(Where: integer);
  416. {This procedure will frame the windoiw or printable page.}
  417. Var
  418.     DisplayArea: Rect;
  419.     TempPort:    GrafPtr;      {holds the current port while printport is used}
  420.     halflen:     integer;      {used for centering the text}
  421.     Starth:      integer;      {horizontal position of centered text}
  422.     Startv:      integer;      {vertical position of centered text}
  423.     dummy:       boolean;      {just a dummy boolean for function assignment}
  424.  
  425. Begin
  426.   InitDisplayArea(Where, DisplayArea);
  427.  
  428. {frame the display area}
  429.   Pensize(3,3);
  430.   FrameRect(DisplayArea);
  431.   pensize(1,1);
  432.  
  433. {place some centered text in frame, first set the text params}
  434.   TextFont(CurntFontID);                    {set the printers port font}
  435.   TextFace(CurntStyleID);                   {set the printers port style}
  436.   TextSize(CurntSizeID);                    {set the printers port size}
  437.  
  438. {find the center}
  439.   starth := (DisplayArea.right - DisplayArea.left) div 2;
  440.   Halflen := StringWidth('The printable area is enclosed by this frame') Div 2;
  441.   starth := starth - halflen;
  442.   startv := (DisplayArea.bottom - DisplayArea.top) div 2;
  443.  
  444. {move to position & draw}
  445.   MoveTo(starth, startv);
  446.   DrawString('The printable area is enclosed by this frame');
  447.  
  448. End;
  449.  
  450. {-----------------------------------------------------------------------------}
  451.  
  452. PROCEDURE PrintBitMap(where: integer);
  453. {This prints a bit map in the rPage area.}
  454. Var
  455.     DisplayArea: Rect;
  456.     srcBits:     BitMap;
  457.     srcRect:     Rect;
  458.     dummy:       boolean;
  459. Begin
  460.   InitDisplayArea(Where, DisplayArea);
  461.  
  462. {set the bit map up}
  463.   srcBits.baseAddr:=@icons[0];           {set start address for Lisa icon}
  464.   srcBits.rowBytes:=6;                   {set 6 as # of bytes per row}
  465.   SetRect(srcBits.bounds,0,0,48,32);     {48 X 32 pixels = 6 X 4 bytes}
  466.   srcRect:=srcBits.bounds;               {set the source bounding rect}
  467.  
  468. {show it}
  469.   If where = theScreen then
  470.   CopyBits(srcBits,thePort^.portBits,srcRect,DisplayArea,srcCopy,Nil) {fill scr}
  471.   else
  472.   CopyBits(srcBits,thePort^.portBits,srcRect,DefaltPage,srcCopy,Nil); {full page}
  473.  
  474. End;
  475.  
  476. {-----------------------------------------------------------------------------}
  477.  
  478. PROCEDURE UseTextBox(Where: Integer);
  479. Var
  480.     DisplayArea: Rect;
  481.     Count:       Integer;      {used as a counter}
  482.     TextPage:    Rect;         {destRect for the text}
  483.     TextPtr:     Ptr;          {pointer to the actual text}
  484.     TextLength:  integer;      {length of the text}
  485.     TextJustify: integer;      {justification for the text}
  486.     ViewRect:    Rect;         {rect for viewing text}
  487.     DestRect:    Rect;         {rect for storing text}
  488.     TextHandle:  TEHandle;     {handle to text record}
  489.     TextString:  StringHandle; {store string from resources}
  490.  
  491. Begin
  492.   InitDisplayArea(Where, DisplayArea);
  493.  
  494. {first setup the text in the TE record and draw it to the screen}
  495.   ViewRect := DisplayArea;                  {set the display rect}
  496.   DestRect := DisplayArea;
  497.   InSetRect(DestRect,0,4);                  {make the destRect smaller}
  498.  
  499.   TextHandle := TENew(DestRect,ViewRect);   {get a new record}
  500.   TextHandle^^.txFont := CurntFontID;       {set font for display}
  501.   TextHandle^^.txFace := CurntStyleID;      {set style for displaying the text}
  502.   TextHandle^^.txSize := CurntSizeID;       {set size for displaying the text}
  503.  
  504.   TextString := GetString(256);             {get the test string from resources}
  505.  
  506.   HLock(Handle(TextString));                {lock string down}
  507.   HLock(Handle(TextHandle));                {lock text handle down}
  508.   Hlock(Handle(TextHandle^^.hText));        {lock the char handle down}
  509.  
  510.   For count := 1 to 5 do                    {insert it 5 times}
  511.   begin
  512.     TESetSelect(0,0,TextHandle);            {set the place to insert at begining}
  513.     TEInsert(pointer(ord4(TextString^)+1),  {point to the first character}
  514.                     length(TextString^^),   {get the length of the string}
  515.                              TextHandle);   {pass the string to TextHandle}
  516.   end;
  517.  
  518.   TECalText(TextHandle);                    {just to be sure everything is OK}
  519.  
  520.   TextPtr := TextHandle^^.hText^;           {get pointer to the text, its locked}
  521.   TextLength := TextHandle^^.TELength;      {get the length of  the text}
  522.   TextJustify:= 0;                          {set the text justification}
  523.  
  524. {NOTE: TextBox call eraseRect, so its S L O W on the LaserWriter}
  525.   TextBox(TextPtr, TextLength, DisplayArea, TextJustify);   {draw the text}
  526.  
  527.   HUnlock(Handle(TextHandle^^.hText));       {unlock the char handle
  528.   HUnLock(Handle(TextHandle));               {unlock the text handle}
  529.   HUnLock(Handle(TextString));               {unlock the string handle}
  530.  
  531.   TEDispose(TextHandle);
  532. End;
  533.  
  534. {-----------------------------------------------------------------------------}
  535.  
  536. PROCEDURE FrameText(Where: Integer);
  537. Var Txt:         Str255;
  538.     len:         integer;
  539.     i:           integer;
  540.     DisplayArea: Rect;
  541.     Frame:       Rect;
  542.     Start:       Point;
  543.     fInfo:       FontInfo;
  544.     ClpRgn:      RgnHandle;
  545. Begin
  546.   InitDisplayArea(Where, DisplayArea);
  547.  
  548. {use current settings}
  549.   TextFont(CurntFontID);                    {set the font}
  550.   TextFace(CurntStyleID);                   {set the style}
  551.   TextSize(CurntSizeID);                    {set the size}
  552.  
  553. {always start the text at this point}
  554.   Start.v := 50;
  555.   Start.h := 50;
  556.  
  557. {get the string dimensions}
  558.   GetFontInfo(fInfo);                               {using current font}
  559.   Frame.right := StringWidth('Have I been - ypgj - framed correctly') + Start.h;
  560.   Frame.left  := Start.h;
  561.   Frame.bottom:= Start.v + fInfo.descent;
  562.   Frame.top   := Start.v - fInfo.ascent;
  563.  
  564. {now draw the stuff}
  565.   InSetRect(Frame, -1, -1);   {move it out one pixel}
  566.   FrameRect(Frame);
  567.  
  568. (*   this is for testing the clipping of text
  569.   ClpRgn := NewRgn;            {get a place to store clip region}
  570.   GetClip(ClpRgn);             {get the current clip region}
  571.   ClipRect(Frame);             {clip to it}
  572. *)
  573.  
  574.   Moveto(Start.h, Start.v);
  575.   DrawString('Have I been - ypgj - framed correctly');
  576.  
  577. (*  this resets the clip
  578.   SetClip(ClpRgn);             {set the clip back to rPage}
  579.   DisposeRgn(ClpRgn);          {kill the clip region}
  580. *)
  581. End;
  582.  
  583. {-----------------------------------------------------------------------------}
  584.  
  585. PROCEDURE PrintLables(Where: Integer);
  586. {NOTE: this procedure tested SetOrigin - it does not   }
  587. {      work within the PrOpenPage and PrClosePage loop.}
  588. Var DisplayArea: Rect;
  589.     Frame:       Rect;
  590. Begin
  591.   InitDisplayArea(Where, DisplayArea);
  592.  
  593.   SetRect(Frame,0,0,80,50);               {set up the frame}
  594.  
  595. {first row, three lables across}
  596.   SetOrigin(0,0);    PaintRoundRect(Frame,4,4);
  597.   SetOrigin(-90,0);  PaintRoundRect(Frame,4,4);
  598.   SetOrigin(-180,0); PaintRoundRect(Frame,4,4);
  599.  
  600. {second row, three lables across}
  601.   SetOrigin(0,-60);    PaintRoundRect(Frame,4,4);
  602.   SetOrigin(-90,-60);  PaintRoundRect(Frame,4,4);
  603.   SetOrigin(-180,-60); PaintRoundRect(Frame,4,4);
  604.  
  605. {third row, three lables across}
  606.   SetOrigin(0,-120);    PaintRoundRect(Frame,4,4);
  607.   SetOrigin(-90,-120);  PaintRoundRect(Frame,4,4);
  608.   SetOrigin(-180,-120); PaintRoundRect(Frame,4,4);
  609. End;
  610.  
  611. {-----------------------------------------------------------------------------}
  612.  
  613. PROCEDURE PrintText(Where: Integer);
  614.  
  615. {until its defined in interface, define it here}
  616. Type TTxtPicRec = Packed Record
  617.                     tJus: Byte;
  618.                     tFlip:Byte;
  619.                     tRot: Integer;
  620.                     tLine:Byte;
  621.                     tCmmt:Byte;
  622.                   End;
  623.  
  624. Var DisplayArea: Rect;
  625.     LineHt:      Integer;
  626.     LinePos:     Integer;
  627.     fInfo:       FontInfo;
  628.     PicComRec:   TTxtPicRec;
  629.     PicComPtr:   QDPtr;
  630.     PicComHdl:   QDHandle;
  631.  
  632. Begin
  633.   InitDisplayArea(Where, DisplayArea);
  634.  
  635. {setup the pic text comment record pointers, etc}
  636.     PicComPtr :=  @PicComRec;
  637.     PicComHdl :=  @PicComPtr;
  638.  
  639. {initialize the TTxtPicRec}
  640.   PicComRec.tFlip := 0;    {none}
  641.   PicComRec.tRot  := 0;    {rotation}
  642.  
  643. {set the current font stuff}
  644.   TextFont(CurntFontID);        {test changing the font}
  645.   TextFace(CurntStyleID);       {test changing the style}
  646.   TextSize(CurntSizeID);        {test changing the size}
  647.  
  648. {get the line height}
  649.   GetFontInfo(fInfo);           {using current font}
  650.   LineHt := fInfo.descent + fInfo.ascent + fInfo.leading;
  651.   LinePos := LineHT;
  652.  
  653. {this is before starting any pic comments}
  654.   SetOrigin(0,0);
  655.   LinePos := LineHT;   {move to the first line}
  656.  
  657.   Moveto(5,LinePos);DrawString('This is before any Pic Comments');
  658.  
  659.   LinePos := LinePos + LineHT;
  660.   Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
  661.  
  662.  
  663. {----------test the "none" justification}
  664.   PicComRec.tJus := 0;                    {NONE justify}
  665.   PicComment(TextBegin, 6, PicComHdl);    {TEXT BEGIN Comment}
  666.  
  667.   LinePos := LinePos + 2*LineHT;
  668.   Moveto(5,LinePos);DrawString('This is with NONE justification');
  669.  
  670.   LinePos := LinePos + LineHT;
  671.   Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
  672.  
  673. (*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)
  674.  
  675.  
  676. {----------test the "left" justification}
  677.   PicComRec.tJus := 1;                    {LEFT justify}
  678.   PicComment(TextBegin, 6, PicComHdl);  {TEXT BEGIN Comment}
  679.  
  680.   LinePos := LinePos + 2*LineHT;
  681.   Moveto(5,LinePos);DrawString('This is with LEFT justification');
  682.  
  683.   LinePos := LinePos + LineHT;
  684.   Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
  685.  
  686. (*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)
  687.  
  688.  
  689. {----------test the "center" justification}
  690.   PicComRec.tJus := 2;                    {CENTER justify}
  691.   PicComment(TextBegin, 6, PicComHdl);
  692.  
  693.   LinePos := LinePos + 2*LineHT;
  694.   Moveto(5,LinePos);DrawString('This is with CENTER justification');
  695.  
  696.   LinePos := LinePos + LineHT;
  697.   Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
  698.  
  699. (*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)
  700.  
  701.  
  702. {----------test the "right" justification}
  703.   PicComRec.tJus := 3;                    {RIGHT justify}
  704.   PicComment(TextBegin, 6, PicComHdl);    {TEXT BEGIN Comment}
  705.  
  706.   LinePos := LinePos + 2*LineHT;
  707.   Moveto(5,LinePos);DrawString('This is with RIGHT justification');
  708.  
  709.   LinePos := LinePos + LineHT;
  710.   Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
  711.  
  712. (*  PicComment(151, 0, NIL);                  {TEXT END Comment}  *)
  713.  
  714. {----------test the "full" justification}
  715.   PicComRec.tJus := 4;                    {FULL justify}
  716.   PicComment(TextBegin, 6, PicComHdl);    {TEXT BEGIN Comment}
  717.  
  718.   LinePos := LinePos + 2*LineHT;
  719.   Moveto(5,LinePos);DrawString('This is with FULL justification');
  720.  
  721.   LinePos := LinePos + LineHT;
  722.   Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
  723.  
  724.   PicComment(TextEnd, 0, NIL);             {TEXT END Comment}
  725.  
  726. End;
  727.  
  728. {-----------------------------------------------------------------------------}
  729.  
  730. PROCEDURE PrintRotText(Where: Integer);
  731.  
  732. {until its defined in interface, define it here}
  733. Type TTxtPicRec = Packed Record
  734.                     tJus: Byte;
  735.                     tFlip:Byte;
  736.                     tRot: Integer;
  737.                     tLine:Byte;
  738.                     tCmmt:Byte;
  739.                   End;
  740.  
  741.      TTxtCenter = Packed Record
  742.                     yInt: Integer;
  743.                     yFrac:Integer;
  744.                     xInt: Integer;
  745.                     xFrac:Integer;
  746.                   End;
  747.  
  748. Var DisplayArea: Rect;
  749.     LineHt:      Integer;
  750.     LinePos:     Integer;
  751.     fInfo:       FontInfo;
  752.  
  753.     PicComRec:   TTxtPicRec;
  754.     PicComPtr:   QDPtr;
  755.     PicComHdl:   QDHandle;
  756.  
  757.     TexRotRec:   TTxtCenter;
  758.     TexRotPtr:   QDPtr;
  759.     TexRotHdl:   QDHandle;
  760.  
  761. Begin
  762.   InitDisplayArea(Where, DisplayArea);
  763.  
  764. {set the current font stuff}
  765.   TextFont(CurntFontID);        {use the current font}
  766.   TextFace(CurntStyleID);       {use the current style}
  767.   TextSize(CurntSizeID);        {use the current size}
  768.  
  769. {setup the pic text comment record pointers, etc}
  770.   PicComPtr :=  @PicComRec;
  771.   PicComHdl :=  @PicComPtr;
  772.  
  773.   TexRotPtr :=  @TexRotRec;
  774.   TexRotHdl :=  @TexRotPtr;
  775.  
  776.   PicComRec.tJus := 1;     {left justify}
  777.   PicComRec.tFlip:= 0;     {none}
  778.   PicComRec.tRot := 45;    {rotate 45 degrees CW}
  779.  
  780.   TexRotRec.yInt := 70;    {move down 60 pixels}
  781.   TexRotRec.yFrac:= 0;     {make it 60.0}
  782.   TexRotRec.xInt := 20;    {move across 20 pixels}
  783.   TexRotRec.xFrac:= 0;     {make it 20.0}
  784.  
  785.   PicComment(TextBegin,  6, PicComHdl);
  786.   PicComment(TextCenter, 8, TexRotHdl);
  787.  
  788.   MoveTo(10,30); DrawString('This text is rotated 45 degrees');
  789.  
  790.   PicComment(TextEnd, 0, NIL);
  791.  
  792. End;
  793.  
  794. {-----------------------------------------------------------------------------}
  795.  
  796. PROCEDURE PrintFineGrid (Where: Integer);
  797. Var DisplayArea: Rect;
  798.     Vinc, Hinc:  integer;
  799.     pos:         integer;
  800.     Boxes:       integer;
  801.     count:       integer;
  802.     FineLine:    rect;
  803. Begin
  804.   InitDisplayArea(Where, DisplayArea);
  805.  
  806. {divide the page into box's}
  807.   Boxes := 16;
  808.   Hinc := DisplayArea.right Div Boxes;
  809.   Vinc := DisplayArea.bottom Div Boxes;
  810.  
  811. {do the vertical lines first}
  812.   FineLine.top :=    DisplayArea.Top;
  813.   FineLine.bottom := DisplayArea.Bottom;
  814.  
  815.   pos := DisplayArea.Left;         {start at the left}
  816.   For count := 1 to boxes do
  817.   begin
  818.     FineLine.left:= pos;
  819.     If where = theScreen
  820.       then FineLine.right := pos + 1
  821.       else FineLine.right := pos;
  822.     FillRect(FineLine, black);
  823.     pos := pos + Hinc;
  824.   end;
  825.  
  826. {do the horizontal lines next}
  827.   FineLine.left :=  DisplayArea.left;
  828.   FineLine.right := DisplayArea.right;
  829.  
  830.   pos := DisplayArea.top;
  831.   For count := 1 to boxes do
  832.   begin
  833.     FineLine.top:= pos;              {start at the top}
  834.     If where = theScreen
  835.       then FineLine.bottom := pos + 1
  836.       else FineLine.bottom := pos;
  837.     FillRect(FineLine, black);
  838.     pos := pos + Vinc;
  839.   end;
  840.  
  841.   FrameRect(DisplayArea);
  842. End;
  843.  
  844. {-----------------------------------------------------------------------------}
  845.  
  846. PROCEDURE PrintPolygon  (Where: Integer);
  847. Type TPolyVerb = Packed Record
  848.                   f7,f6,f5,f4,f3,fPolyClose, fPolyFill, fPolyFrame:Boolean;
  849.                  End;
  850.  
  851. Var DisplayArea:  Rect;
  852.     PolyComRec:   TPolyVerb;
  853.     PolyComPtr:   QDPtr;
  854.     PolyComHdl:   QDHandle;
  855.     PolyHdl:      PolyHandle;
  856.  
  857.  
  858. Begin
  859.   InitDisplayArea(Where, DisplayArea);
  860.  
  861.   If where = theLaserW then
  862.     begin
  863.     sysbeep(3);
  864.       PolyComRec.fPolyClose := true;      {closed the polygon}
  865.       PolyComRec.fPolyFrame := true;      {frame the polygon}
  866.       PolyComRec.fPolyFill  := false;     {don't fill the polygon}
  867.       PolyComPtr:= @PolyComRec;           {get the pointer set up}
  868.       PolyComHdl:= @PolyComPtr;           {get the handle set up}
  869.  
  870.   {draw the rectangle}
  871.       MoveTo(20,20);                      {set the initial position}
  872.       PicComment(PolyBegin, 0, Nil);      {start the polygon, simple 80 X 80 square}
  873.       PicComment(PolyVerb, 1,PolyComHdl); {send the frame & close command}
  874.         LineTo(100,20);
  875.         LineTo(100,100);
  876.         LineTo(20,100);
  877.         LineTo(20,20);
  878.       PicComment(PolyEnd, 0, Nil);        {end the polygon}
  879.  
  880.   {draw the triangle}
  881.       MoveTo(150,200);
  882.       PolyComRec.fPolyFill  := true;      {fill the polygon}
  883.       PicComment(PolyBegin, 0, Nil);      {start the polygon, simple 80 X 80 square}
  884.       PicComment(PolyVerb, 1,PolyComHdl); {send the fill, frame & close command}
  885.         LineTo(200,250);
  886.         LineTo(100,250);
  887.         LineTo(150,200);
  888.       PicComment(PolyEnd, 0, Nil);        {end the polygon}
  889.     end
  890.  
  891.  
  892.   else  {use the regular stuff and show it on the screen}
  893.     begin
  894.       PolyHdl := OpenPoly;
  895.         MoveTo(20,20);
  896.         LineTo(100,20);
  897.         LineTo(100,100);
  898.         LineTo(20,100);
  899.         LineTo(20,20);
  900.       ClosePoly;
  901.       FramePoly(PolyHdl);
  902.       KillPoly(PolyHdl);
  903.  
  904.       PolyHdl := OpenPoly;
  905.         MoveTo(150,200);
  906.         LineTo(200,250);
  907.         LineTo(100,250);
  908.         LineTo(150,200);
  909.       ClosePoly;
  910.       FillPoly(PolyHdl, LtGray);
  911.       FramePoly(polyHdl);
  912.       KillPoly(PolyHdl);
  913.     end;
  914. End;
  915.  
  916. {-----------------------------------------------------------------------------}
  917.  
  918.  
  919. PROCEDURE BuildQDPicture(where:integer);
  920. Var
  921.     OriginalRect: Rect;
  922.     SaveClip:     RgnHandle;
  923.  
  924. Begin
  925.   SetRect(OriginalRect,0,0,719,363);       {this rect holds the initial Pic}
  926.   SaveClip := NewRgn;                      {get a Rgn to store the clip}
  927.   GetClip(SaveClip);                       {save the current clip region}
  928.   ClipRect(OriginalRect);                  {set the clip to the drawing area}
  929.  
  930.   QDPicture := OpenPicture(OriginalRect);  {start the picture}
  931.   Pensize(3,3);
  932.   FrameRect(OriginalRect);                 {frame it}
  933.   PenSize(1,1);
  934.   MakeQDCalls(where);                      {draw the QD calls}
  935.   ClosePicture;                            {close it}
  936.  
  937.   SetClip(SaveClip);                       {reset the clip }
  938.   DisposeRgn(SaveClip);                    {get rid of new clip}
  939. End;
  940.  
  941. {-----------------------------------------------------------------------------}
  942.  
  943. PROCEDURE ShowQDPic(Where:integer);
  944. Var DisplayArea: Rect;
  945. Begin
  946.   If where = theScreen
  947.   then begin
  948.     InitDisplayArea(Where, DisplayArea);
  949.     BuildQDPicture(where);                 {knock out some things if goint to Laser}
  950.     DrawPicture(QDPicture, DisplayArea);
  951.   end
  952.  
  953.   else {build the picture some where else}
  954.    DrawPicture(QDPicture, DefaltPage);
  955.  
  956.   KillPicture(QDPicture);
  957. End;
  958.  
  959. {-----------------------------------------------------------------------------}
  960.  
  961. PROCEDURE ShowAllQDCalls(Where:integer);
  962. Var DisplayArea: Rect;
  963. Begin
  964.   InitDisplayArea(Where, DisplayArea);
  965.   MakeQDCalls(Where);
  966. End;
  967.  
  968. {-----------------------------------------------------------------------------}
  969.  
  970. PROCEDURE DrawIcon(whichIcon,h,v: integer);
  971. {This procedure draws an icon at location h, v}
  972. Var
  973.     srcBits           : BitMap;
  974.     srcRect, dstRect  : Rect;
  975.  
  976. Begin
  977.   srcBits.baseAddr:=@icons[whichIcon];   {set start address for icon data}
  978.   srcBits.rowBytes:=6;                   {set 6 as # of bytes per row}
  979.   SetRect(srcBits.bounds,0,0,48,32);     {48 X 32 pixels = 6 X 4 bytes}
  980.   srcRect:=srcBits.bounds;               {set the source bounding rect}
  981.   dstRect:=srcRect;                      {make the destination rect the same}
  982.   OffsetRect(dstRect,h,v);               {offset from other icons}
  983.  
  984.   CopyBits(srcBits,thePort^.portBits,srcRect,dstRect,srcOr,Nil);
  985. End;
  986.  
  987. {-----------------------------------------------------------------------------}
  988.  
  989. PROCEDURE MakeQDCalls(where:integer);
  990. VAR i: INTEGER;
  991.     tempRect,
  992.     OriginalRect : Rect;
  993.     myPoly       : PolyHandle;
  994.     myRgn        : RgnHandle;
  995.     myPattern    : Pattern;
  996.  
  997. BEGIN
  998.  
  999.   {SetRect(OriginalRect,0,0,719,363);  this rect holds the initial Pic}
  1000.  
  1001.   { draw two horizontal lines across the top }
  1002.   MoveTo(0,18);
  1003.   LineTo(719,18);
  1004.   MoveTo(0,20);
  1005.   LineTo(719,20);
  1006.  
  1007.   { draw divider lines }
  1008.   MoveTo(0,134);
  1009.   LineTo(719,134);
  1010.   MoveTo(0,248);
  1011.   LineTo(719,248);
  1012.   MoveTo(240,21);
  1013.   LineTo(240,363);
  1014.   MoveTo(480,21);
  1015.   LineTo(480,363);
  1016.  
  1017. {set the current font stuff}
  1018.   TextFont(CurntFontID);        {use the current font}
  1019.   TextFace(CurntStyleID);       {use the current style}
  1020.   TextSize(CurntSizeID);        {use the current size}
  1021.  
  1022. {draw title}
  1023.   MoveTo(210,14);
  1024.   DrawString('Look what you can draw with QuickDraw');
  1025.  
  1026.  
  1027.   {---------  draw text samples --------- }
  1028.  
  1029.   MoveTo(80,34);  DrawString('Text');
  1030.  
  1031.   TextFace([bold]);
  1032.   MoveTo(70,55);  DrawString('Bold');
  1033.  
  1034.   TextFace([italic]);
  1035.   MoveTo(70,70); DrawString('Italic');
  1036.  
  1037.   TextFace([underline]);
  1038.   MoveTo(70,85); DrawString('Underline');
  1039.  
  1040.   TextFace([outline]);
  1041.   MoveTo(70,100); DrawString('Outline');
  1042.  
  1043.   TextFace([shadow]);
  1044.   MoveTo(70,115); DrawString('Shadow');
  1045.  
  1046.   TextFace([]);   { restore to normal }
  1047.  
  1048.  
  1049.   { --------- draw line samples --------- }
  1050.  
  1051.   MoveTo(330,34);  DrawString('Lines');
  1052.  
  1053.   MoveTo(280,25);  Line(160,40);
  1054.  
  1055.   PenSize(3,2);
  1056.   MoveTo(280,35);  Line(160,40);
  1057.  
  1058.   PenSize(6,4);
  1059.   MoveTo(280,46);  Line(160,40);
  1060.  
  1061.   PenSize(12,8);
  1062.   PenPat(gray);
  1063.   MoveTo(280,61); Line(160,40);
  1064.  
  1065.   PenSize(15,10);
  1066.   StuffHex(@myPattern,'8040200002040800'); {create a new pattern}
  1067.   PenPat(myPattern);                       {set as the new pen pattern}
  1068.   MoveTo(280,80); Line(160,40);
  1069.   PenNormal;
  1070.  
  1071.   { --------- draw rectangle samples --------- }
  1072.  
  1073.   MoveTo(560,34);  DrawString('Rectangles');
  1074.  
  1075.   SetRect(tempRect,510,40,570,70);
  1076.   FrameRect(tempRect);
  1077.  
  1078.   OffsetRect(tempRect,25,15);
  1079.   PenSize(3,2);
  1080.   EraseRect(tempRect); {this is so the top rect will not show thru the next one}
  1081.   FrameRect(tempRect);
  1082.  
  1083.   OffsetRect(tempRect,25,15);
  1084.   PaintRect(tempRect);   {this rect is painted so we do not have to erase area}
  1085.  
  1086.   OffsetRect(tempRect,25,15);
  1087.   PenNormal;
  1088.   FillRect(tempRect,gray);
  1089.   FrameRect(tempRect);
  1090.  
  1091.   OffsetRect(tempRect,25,15);
  1092.   FillRect(tempRect,myPattern);
  1093.   FrameRect(tempRect);
  1094.  
  1095.   { --------- draw roundRect samples --------- }
  1096.  
  1097.   MoveTo(70,148);  DrawString('RoundRects');
  1098.  
  1099.   SetRect(tempRect,30,150,90,180);
  1100.   FrameRoundRect(tempRect,30,20);
  1101.  
  1102.   OffsetRect(tempRect,25,15);
  1103.   PenSize(3,2);
  1104.   EraseRoundRect(tempRect,30,20);
  1105.   FrameRoundRect(tempRect,30,20);
  1106.  
  1107.   OffsetRect(tempRect,25,15);
  1108.   PaintRoundRect(tempRect,30,20);
  1109.  
  1110.   OffsetRect(tempRect,25,15);
  1111.   PenNormal;
  1112.   FillRoundRect(tempRect,30,20,gray);
  1113.   FrameRoundRect(tempRect,30,20);
  1114.  
  1115.   OffsetRect(tempRect,25,15);
  1116.   FillRoundRect(tempRect,30,20,myPattern);
  1117.   FrameRoundRect(tempRect,30,20);
  1118.  
  1119.   { --------- draw bitmap samples --------- }
  1120.  
  1121.   MoveTo(320,148);  DrawString('BitMaps');
  1122.  
  1123.   DrawIcon(0,266,156);
  1124.   DrawIcon(1,336,156);
  1125.   DrawIcon(2,406,156);
  1126.   DrawIcon(3,266,196);
  1127.   DrawIcon(4,336,196);
  1128.   DrawIcon(5,406,196);
  1129.  
  1130.   { --------- draw ARC samples --------- }
  1131.  
  1132.   MoveTo(570,148);  DrawString('Arcs');
  1133.  
  1134.   SetRect(tempRect,520,153,655,243);
  1135.   FillArc(tempRect,135,65,dkGray);
  1136.   FillArc(tempRect,200,130,myPattern);
  1137.   FillArc(tempRect,330,75,gray);
  1138.   FrameArc(tempRect,135,270);
  1139.   OffsetRect(tempRect,20,0);
  1140.   PaintArc(tempRect,45,90);
  1141.  
  1142.   { --------- draw polygon samples --------- }
  1143.  
  1144.   MoveTo(80,262);  DrawString('Polygons');
  1145.  
  1146.   myPoly:=OpenPoly;     {capture QD calls that make up the polygon}
  1147.     MoveTo(30,290);
  1148.     LineTo(30,280);
  1149.     LineTo(50,265);
  1150.     LineTo(90,265);
  1151.     LineTo(80,280);
  1152.     LineTo(95,290);
  1153.     LineTo(30,290);
  1154.   ClosePoly;           { end of definition of the polygon}
  1155.  
  1156.   FramePoly(myPoly);   {now use it just like you would a rectangle or etc.}
  1157.  
  1158.   OffsetPoly(myPoly,25,15);
  1159.   PenSize(3,2);
  1160.   ErasePoly(myPoly);
  1161.   FramePoly(myPoly);
  1162.  
  1163.   OffsetPoly(myPoly,25,15);
  1164.   PaintPoly(myPoly);
  1165.  
  1166.   OffsetPoly(myPoly,25,15);
  1167.   PenNormal;
  1168.   FillPoly(myPoly,gray);
  1169.   FramePoly(myPoly);
  1170.  
  1171.   OffsetPoly(myPoly,25,15);
  1172.   FillPoly(myPoly,myPattern);
  1173.   FramePoly(myPoly);
  1174.  
  1175.   KillPoly(myPoly);
  1176.  
  1177.   { --------- demonstrate regions --------- }
  1178.  
  1179.   MoveTo(320,262);  DrawString('Regions');
  1180.  
  1181.   If where <> theLaserW
  1182.   then
  1183.     begin
  1184.  
  1185.       myRgn:=NewRgn;       {allocate space of a new region}
  1186.       OpenRgn;             {start saving region defintion calls}
  1187.  
  1188.         ShowPen;  {OpenRgn calls HidePen so if drawing to screen call ShowPen }
  1189.                   {if creating a picture delete this call}
  1190.  
  1191.         SetRect(tempRect,260,270,460,350);
  1192.         FrameRoundRect(tempRect,24,16);    {rounded corner rectangle}
  1193.  
  1194.         MoveTo(275,335);  { define triangular hole }
  1195.         LineTo(325,285);
  1196.         LineTo(375,335);
  1197.         LineTo(275,335);
  1198.  
  1199.         SetRect(tempRect,365,277,445,325);   { oval hole }
  1200.         FrameOval(tempRect);
  1201.  
  1202.         HidePen;   {this call would balance the ShowPen call set above}
  1203.       CloseRgn(myRgn);       { end of definition of the region}
  1204.       PaintRgn(myRgn);       {show the region with black pattern}
  1205.       DisposeRgn(myRgn);     {dont need it any more so throw it away}
  1206.     end
  1207.  
  1208.   else
  1209.     begin
  1210.       MoveTo(270,300);  DrawString('Dont use regions');
  1211.       Moveto(275,320);  DrawString('on LaserPrinter');
  1212.     end;
  1213.  
  1214.   { --------- draw oval samples --------- }
  1215.  
  1216.   MoveTo(580,262);  DrawString('Ovals');
  1217.  
  1218.   SetRect(tempRect,510,264,570,294);
  1219.   FrameOval(tempRect);
  1220.  
  1221.   OffsetRect(tempRect,25,15);
  1222.   PenSize(3,2);
  1223.   EraseOval(tempRect);
  1224.   FrameOval(tempRect);
  1225.  
  1226.   OffsetRect(tempRect,25,15);
  1227.   PaintOval(tempRect);
  1228.  
  1229.   OffsetRect(tempRect,25,15);
  1230.   PenNormal;
  1231.   FillOval(tempRect,gray);
  1232.   FrameOval(tempRect);
  1233.  
  1234.   OffsetRect(tempRect,25,15);
  1235.   FillOval(tempRect,myPattern);
  1236.   FrameOval(tempRect);
  1237.  
  1238. END; {QDCalls}
  1239.  
  1240. {-----------------------------------------------------------------------------}
  1241.  
  1242. PROCEDURE ChkOnOffItem(MenuHdl:MenuHandle; item, fst, lst:Integer);
  1243. Var i: integer;
  1244. Begin
  1245.   For i := fst to lst do
  1246.     If item = i
  1247.     then CheckItem(MenuHdl, i, TRUE)       {check it on in menu}
  1248.     else CheckItem(MenuHdl, i, FALSE);     {check it off in menu}
  1249. End;
  1250.  
  1251. {-----------------------------------------------------------------------------}
  1252.  
  1253. PROCEDURE ProcessMenu_in(CodeWord:longint; fromMenu:Boolean);
  1254. Var
  1255.   Menu_No,                    {menu number that was selected}
  1256.   Item_No:    integer;        {item in menu that was selected}
  1257.   NameHolder: Str255;         {name holder for desk accessory or font}
  1258.   MenuHdl:    MenuHandle;     {handle to the menu}
  1259.   dummy:      boolean;
  1260.   LDummy:     LongInt;
  1261.   PrChooser:  LMwordPtr;      {used to disable/enable the chooser}
  1262.  
  1263. Begin
  1264.   If CodeWord <> 0 then {go ahead and process the command}
  1265.   begin
  1266.     Menu_No := HiWord(CodeWord);
  1267.     Item_No := LoWord(CodeWord);
  1268.  
  1269.     Case Menu_No of
  1270.  
  1271.      AppleMenu: begin
  1272.                   GetItem(GetMenu(AppleMenu), Item_No, NameHolder);
  1273.                   If OpenDeskAcc(NameHolder) = 0
  1274.                   then begin {put up a dialog saying it cannot open it} end;
  1275.                 end;
  1276.  
  1277.     PrDlogMenu: begin
  1278.                    Case Item_No of
  1279.                      1: begin
  1280.                           dummy := PrStlDialog(PrRecordHdl);
  1281.                         end;
  1282.                      2: begin
  1283.                           If PrJobDialog(PrRecordHdl)
  1284.                           then PrintIt(CurPrTest);
  1285.                         end;
  1286.  
  1287.                     {3: line divider}
  1288.  
  1289.                      4: begin
  1290.                           PrChooser := LMwordPtr($946);       {set the address}
  1291.                           GetStuff(PrChooser^).f15 := FALSE;  {set bit7 of $946}
  1292.                         end;
  1293.                      5: begin
  1294.                           PrChooser := LMwordPtr($946);       {set the address}
  1295.                           GetStuff(PrChooser^).f15 := TRUE;   {set bit7 of $946}
  1296.                         end;
  1297.  
  1298.                     {6: line divider}
  1299.  
  1300.                      7:Finished := true;      {terminate the program}
  1301.                    End;
  1302.                  end;
  1303.  
  1304.       PrintMenu: Begin
  1305.                   MenuHdl := GetMenu(PrintMenu);    {menu handle for PrTests}
  1306.                   Case Item_No of
  1307.                    1: begin
  1308.                         CurPrTest := PrFramePage;
  1309.                         ChkOnOffItem(MenuHdl, 1, 1, 11);
  1310.                         FramePage(theScreen);
  1311.                       end;
  1312.  
  1313.                    2: begin
  1314.                         CurPrTest := PrFrameText;
  1315.                         ChkOnOffItem(MenuHdl, 2, 1, 11);
  1316.                         FrameText(theScreen);
  1317.                       end;
  1318.  
  1319.                    3: begin
  1320.                         CurPrTest := PrMakeQDCalls;
  1321.                         ChkOnOffItem(MenuHdl, 3, 1, 11);
  1322.                         ShowAllQDCalls(theScreen);
  1323.                       end;
  1324.  
  1325.                    4: begin
  1326.                         CurPrTest := PrDrawPicture;
  1327.                         ChkOnOffItem(MenuHdl, 4, 1, 11);
  1328.                         ShowQDPic(theScreen);
  1329.                       end;
  1330.  
  1331.                    5: begin
  1332.                         CurPrTest := PrUseTextBox;
  1333.                         ChkOnOffItem(MenuHdl, 5, 1, 11);
  1334.                         UseTextBox(theScreen);
  1335.                       end;
  1336.  
  1337.                    6: begin
  1338.                         CurPrTest := PrBitMap;
  1339.                         ChkOnOffItem(MenuHdl, 6, 1, 11);
  1340.                         PrintBitMap(theScreen);
  1341.                       end;
  1342.  
  1343.                    7: begin
  1344.                         CurPrTest := PrChkSetOrig;
  1345.                         ChkOnOffItem(MenuHdl, 7, 1, 11);
  1346.                         PrintLables(theScreen);
  1347.                       end;
  1348.  
  1349.                    8: begin
  1350.                         CurPrTest := PrChkPicComm;
  1351.                         ChkOnOffItem(MenuHdl, 8, 1, 11);
  1352.                         PrintText(theScreen);
  1353.                       end;
  1354.  
  1355.                    9: begin
  1356.                         CurPrTest := PrRotateTex;
  1357.                         ChkOnOffItem(MenuHdl, 9, 1, 11);
  1358.                         PrintRotText(theScreen);
  1359.                       end;
  1360.  
  1361.  
  1362.                   10: begin
  1363.                         CurPrTest := PrFineGrid;
  1364.                         ChkOnOffItem(MenuHdl, 10, 1, 11);
  1365.                         PrintFineGrid(theScreen);
  1366.                       end;
  1367.  
  1368.                   11: begin
  1369.                         CurPrTest := PrSmothPloy;
  1370.                         ChkOnOffItem(MenuHdl, 11, 1, 11);
  1371.                         PrintPolygon(theScreen);
  1372.                       end;
  1373.  
  1374.                    End;
  1375.                  End;
  1376.  
  1377.        FontMenu: begin
  1378.                    MenuHdl := GetMenu(FontMenu);             {menu handle for fonts}
  1379.                    CheckItem(MenuHdl, PrevFontChked, False); {uncheck the prev.one}
  1380.                    GetItem(MenuHdl, Item_No, NameHolder);    {get new font name}
  1381.                    PrevFontChked := Item_No;                 {save the new font No}
  1382.                    GetFNum(NameHolder, CurntFontID);         {get the font ID}
  1383.                    CheckItem(MenuHdl, Item_No, True);        {check it off in menu}
  1384.                  end;
  1385.  
  1386.       StyleMenu: begin
  1387.                    MenuHdl := GetMenu(StyleMenu);          {menu handle for style}
  1388.                    Case Item_No of
  1389.                      1:begin
  1390.                          CurntStyleID := [];      {plain}
  1391.                          ChkOnOffItem(MenuHdl, 1, 1, 6);
  1392.                        end;
  1393.                      2:begin
  1394.                          CurntStyleID := CurntStyleID + [Bold];
  1395.                          CheckItem(MenuHdl, 2, True);      {check it off in menu}
  1396.                          CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
  1397.                        end;
  1398.                      3:begin
  1399.                          CurntStyleID := CurntStyleID + [Italic];
  1400.                          CheckItem(MenuHdl, 3, True);     {check it off in menu}
  1401.                          CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
  1402.                        end;
  1403.                      4:begin
  1404.                          CurntStyleID := CurntStyleID + [underline];
  1405.                          CheckItem(MenuHdl, 4, True);     {check it off in menu}
  1406.                          CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
  1407.                        end;
  1408.                      5:begin
  1409.                          CurntStyleID := CurntStyleID + [outline];
  1410.                          CheckItem(MenuHdl, 5, True);     {check it off in menu}
  1411.                          CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
  1412.                        end;
  1413.                      6:begin
  1414.                          CurntStyleID := CurntStyleID + [shadow];
  1415.                          CheckItem(MenuHdl, 6, True);      {check it off in menu}
  1416.                          CheckItem(MenuHdl, 1, False);     {uncheck it in menu}
  1417.                        end;
  1418.  
  1419.                     {7: line divider}
  1420.  
  1421.                      8:begin  {9 point}
  1422.                          CurntSizeID := 9;
  1423.                          ChkOnOffItem(MenuHdl, 8, 8, 13);
  1424.                        end;
  1425.                      9:begin  {10 point}
  1426.                          CurntSizeID := 10;
  1427.                          ChkOnOffItem(MenuHdl, 9, 8, 13);
  1428.                        end;
  1429.                     10:begin  {12 point}
  1430.                          CurntSizeID := 12;
  1431.                          ChkOnOffItem(MenuHdl, 10, 8, 13);
  1432.                        end;
  1433.                     11:begin  {14 point}
  1434.                          CurntSizeID := 14;
  1435.                          ChkOnOffItem(MenuHdl, 11, 8, 13);
  1436.                        end;
  1437.                     12:begin  {18 point}
  1438.                          CurntSizeID := 18;
  1439.                          ChkOnOffItem(MenuHdl, 12, 8, 13);
  1440.                        end;
  1441.                     13:begin  {24 point}
  1442.                          CurntSizeID := 24;
  1443.                          ChkOnOffItem(MenuHdl, 13, 8, 13);
  1444.                        end;
  1445.  
  1446.                    End;
  1447.                  end;
  1448.  
  1449.       PrDrvrMenu:begin
  1450.                    Case Item_No of
  1451.                      1: PrDrBitMap;
  1452.                      2: PrDrScr_wEvtCtl;
  1453.                      3: PrDrScrBitMap;
  1454.                      4: PrDrStreamText;
  1455.                      5: PrDrPostScript;
  1456.                    End;
  1457.                  end;
  1458.  
  1459.       PicScrMenu:begin
  1460.                    If Item_No = 1 then PutPicScrap;
  1461.                  end;
  1462.  
  1463.     End;{case of Menu_No}
  1464.  
  1465.     HiliteMenu(0);               {unhilite after processing menu}
  1466.   end; {the If codeword <> 0}
  1467. End; {of ProcessMenu_in procedure}
  1468.  
  1469. {-----------------------------------------------------------------------------}
  1470.  
  1471. PROCEDURE DealwthMouseDowns(Event:EventRecord);
  1472. Var Location: integer;
  1473.     WindowPointedTo: WindowPtr;
  1474.     MouseLoc:Point;
  1475.     WindoLoc:integer;
  1476. Begin
  1477.   MouseLoc := Event.Where;
  1478.   WindoLoc := FindWindow(MouseLoc, WindowPointedTo);
  1479.   Case WindoLoc of
  1480.  
  1481.      inMenuBar: ProcessMenu_in(MenuSelect(MouseLoc), True);
  1482.  
  1483.      inSysWindow: SystemClick(Event,WindowPointedTo);
  1484.  
  1485.      inContent: begin end;
  1486.               (*If WindowPointedTo <> FrontWindow
  1487.                 then SelectWindow(WindowPointedTo)
  1488.                 else begin {do something} end;*)
  1489.  
  1490.      inGrow   : begin end;
  1491.               (*If WindowPointedTo <> FrontWindow
  1492.                 then SelectWindow(WindowPointedTo)
  1493.                 else ReSizeWindow(WindowPointedTo,MouseLoc,GrowArea);*)
  1494.  
  1495.      inDrag   :DragWindow(WindowPointedTo,MouseLoc,DragArea);
  1496.  
  1497.      inGoAway :If TrackGoAway(WindowPointedTo,MouseLoc)
  1498.                then
  1499.                  begin
  1500.                    CloseWindow(WindowPointedTo);
  1501.                    Finished := true;
  1502.                  end;
  1503.  
  1504.   End{ of case};
  1505. End;
  1506.  
  1507. {-----------------------------------------------------------------------------}
  1508.  
  1509. PROCEDURE DealwthKeyDowns(Event:EventRecord);
  1510. Var Character:char;
  1511. Begin
  1512.    Character:= CHR(Event.message MOD 256);
  1513.  
  1514.   If BitTst(@Event.modifier,Bit7)
  1515.    then
  1516.      begin  {key board command}
  1517.        ProcessMenu_in(MenuKey(Character), False);
  1518.      end
  1519.    else
  1520.      begin  {regular keyboard entry}
  1521.        {TEKey(Character,TextHandle);}
  1522.        {Scrolltext}
  1523.      end;
  1524. End;
  1525.  
  1526. {-----------------------------------------------------------------------------}
  1527.  
  1528. PROCEDURE DealwthActivates(Event: EventRecord);
  1529. Var EventMsgWindow:WindowPtr;
  1530. Begin
  1531.    EventMsgWindow := WindowPtr(Event.message);
  1532.    {DrawGrowIcon(EventMsgWindow);}
  1533.  
  1534.    If Odd(Event.modifiers) {then the window is becoming active}
  1535.    then
  1536.      begin
  1537.        SetPort(EventMsgWindow);
  1538.        {and activate whatever else you need}
  1539.      end
  1540.    else
  1541.      begin
  1542.        {deactivate whatever you need}
  1543.      end;
  1544. End;
  1545.  
  1546. {-----------------------------------------------------------------------------}
  1547.  
  1548. PROCEDURE DealwthUpdates(Event:EventRecord);
  1549. Var EventMsgWindow,
  1550.           TempPort: WindowPtr;
  1551. Begin
  1552.    EventMsgWindow := WindowPtr(Event.message);
  1553.    GetPort(TempPort);                {Save the current port}
  1554.  
  1555.    SetPort    (EventMsgWindow);      {set the port to one in Evt.msg}
  1556.    BeginUpDate(EventMsgWindow);
  1557.      EraseRect(EventMsgWindow^.portRect);
  1558.     { WhichPrinter;                              Proc to ID the printer}
  1559.      {DrawGrowIcon(EventMsgWindow);}
  1560.    EndUpDate  (EventMsgWindow);
  1561.    SetPort    (TempPort);             {restore to the previous port}
  1562. End;
  1563.  
  1564. {-----------------------------------------------------------------------------}
  1565.  
  1566. PROCEDURE MainEventLoop;
  1567. Var Event:EventRecord;
  1568.     ProcessIt: Boolean;
  1569. Begin
  1570.   Repeat
  1571.     SystemTask;             {so you can support Desk Accessories}
  1572.  
  1573.     ProcessIt := GetNextEvent(EveryEvent,Event);
  1574.     If ProcessIt{is true} then {we'll ProcessIt}
  1575.           Case Event.what of
  1576.  
  1577.             mouseDown  : DealwthMouseDowns(Event);
  1578.             KeyDown    : DealwthKeyDowns  (Event);
  1579.             ActivateEvt: DealwthActivates (Event);
  1580.             UpDateEvt  : DealwthUpdates   (Event);
  1581.  
  1582.           End;{of Case}
  1583.   Until Finished; {terminate the program}
  1584. End;
  1585.  
  1586. {-----------------------------------------------------------------------------}
  1587.  
  1588. PROCEDURE InitIcons;
  1589. { Manually stuff some icons.  Normally we would read them from a file }
  1590. BEGIN
  1591. {each line contains 48 HEX #s which fill 12 consecutive words up to 96}
  1592.  
  1593.   { Lisa }
  1594.   StuffHex(@icons[0, 0],'000000000000000000000000000000000000001FFFFFFFFC');
  1595.   StuffHex(@icons[0,12],'00600000000601800000000B0600000000130FFFFFFFFFA3');
  1596.   StuffHex(@icons[0,24],'18000000004311FFFFF00023120000080F231200000BF923');
  1597.   StuffHex(@icons[0,36],'120000080F23120000080023120000080023120000080F23');
  1598.   StuffHex(@icons[0,48],'1200000BF923120000080F2312000008002311FFFFF00023');
  1599.   StuffHex(@icons[0,60],'08000000004307FFFFFFFFA30100000000260FFFFFFFFE2C');
  1600.   StuffHex(@icons[0,72],'18000000013832AAAAA8A9F0655555515380C2AAAA82A580');
  1601.   StuffHex(@icons[0,84],'800000000980FFFFFFFFF300800000001600FFFFFFFFFC00');
  1602.  
  1603.   { Printer }
  1604.   StuffHex(@icons[1, 0],'000000000000000000000000000000000000000000000000');
  1605.   StuffHex(@icons[1,12],'00000000000000007FFFFF00000080000280000111514440');
  1606.   StuffHex(@icons[1,24],'0002000008400004454510400004000017C00004A5151000');
  1607.   StuffHex(@icons[1,36],'0004000010000004A54510000004000017FE00F4A5151003');
  1608.   StuffHex(@icons[1,48],'0184000013870327FFFFF10F06400000021B0CFFFFFFFC37');
  1609.   StuffHex(@icons[1,60],'18000000006B3000000000D77FFFFFFFFFABC00000000356');
  1610.   StuffHex(@icons[1,72],'8000000001AC87F000000158841000CCC1B087F000CCC160');
  1611.   StuffHex(@icons[1,84],'8000000001C0C000000003807FFFFFFFFF0007800001E000');
  1612.  
  1613.   { Trash Can }
  1614.   StuffHex(@icons[2, 0],'000001FC000000000E0600000000300300000000C0918000');
  1615.   StuffHex(@icons[2,12],'00013849800000026C4980000004C0930000000861260000');
  1616.   StuffHex(@icons[2,24],'0010064FE0000031199830000020E6301800002418E00800');
  1617.   StuffHex(@icons[2,36],'0033E3801C0000180E002C00000FF801CC0000047FFE0C00');
  1618.   StuffHex(@icons[2,48],'000500004C000005259A4C000005250A4C00000525FA4C00');
  1619.   StuffHex(@icons[2,60],'000524024C00000524924C00600524924C0090E524924C7C');
  1620.   StuffHex(@icons[2,72],'932524924C82A44524924D01C88524924CF10C4524924C09');
  1621.   StuffHex(@icons[2,84],'0784249258E70003049233100000E000E40800001FFFC3F0');
  1622.  
  1623.   { tray }
  1624.   StuffHex(@icons[3, 0],'000000000000000000000000000000000000000000000000');
  1625.   StuffHex(@icons[3,12],'0000000000000000000000000000000000000007FFFFFFF0');
  1626.   StuffHex(@icons[3,24],'000E00000018001A00000038003600000078006A000000D8');
  1627.   StuffHex(@icons[3,36],'00D7FFFFFFB801AC000003580358000006B807FC000FFD58');
  1628.   StuffHex(@icons[3,48],'040600180AB80403FFF00D58040000000AB8040000000D58');
  1629.   StuffHex(@icons[3,60],'040000000AB807FFFFFFFD5806AC00000AB8055800000D58');
  1630.   StuffHex(@icons[3,72],'06B000000AB807FC000FFD70040600180AE00403FFF00DC0');
  1631.   StuffHex(@icons[3,84],'040000000B80040000000F00040000000E0007FFFFFFFC00');
  1632.  
  1633.   { File Cabinet }
  1634.   StuffHex(@icons[4, 0],'0007FFFFFC00000800000C00001000001C00002000003400');
  1635.   StuffHex(@icons[4,12],'004000006C0000FFFFFFD40000800000AC0000BFFFFED400');
  1636.   StuffHex(@icons[4,24],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
  1637.   StuffHex(@icons[4,36],'00A00002AC0000A08082D40000A0FF82AC0000A00002D400');
  1638.   StuffHex(@icons[4,48],'00A00002AC0000BFFFFED40000800000AC0000BFFFFED400');
  1639.   StuffHex(@icons[4,60],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
  1640.   StuffHex(@icons[4,72],'00A00002AC0000A08082D40000A0FF82AC0000A00002D800');
  1641.   StuffHex(@icons[4,84],'00A00002B00000BFFFFEE00000800000C00000FFFFFF8000');
  1642.  
  1643.   { drawer }
  1644.   StuffHex(@icons[5, 0],'000000000000000000000000000000000000000000000000');
  1645.   StuffHex(@icons[5,12],'000000000000000000000000000000000000000000000000');
  1646.   StuffHex(@icons[5,24],'000000000000000000000000000000000000000000000000');
  1647.   StuffHex(@icons[5,36],'00000000000000000000000000000000000000001FFFFFF0');
  1648.   StuffHex(@icons[5,48],'0000380000300000680000700000D80000D0003FFFFFF1B0');
  1649.   StuffHex(@icons[5,60],'0020000013500020000016B000201FE01D50002010201AB0');
  1650.   StuffHex(@icons[5,72],'00201FE01560002000001AC0002000001580002020101B00');
  1651.   StuffHex(@icons[5,84],'00203FF01600002000001C00002000001800003FFFFFF000');
  1652.  
  1653. END;
  1654.  
  1655. {-----------------------------------------------------------------------------}
  1656.  
  1657. PROCEDURE PutPicScrap;
  1658. Var err:     LongInt;
  1659.     PicRect: Rect;
  1660.     PicHdl:  PicHandle;
  1661.     PicLen:  LongInt;
  1662. Begin
  1663.   PicRect := DefaltPage;
  1664.   PicRect.bottom := PicRect.bottom Div 2;
  1665.   PicRect.right := PicRect.right Div 2;
  1666.  
  1667.   BuildQDPicture(theScreen);
  1668.  
  1669.   PicHdl := OpenPicture(PicRect);
  1670.   DrawPicture(QDPicture, PicRect);
  1671.   ClosePicture;
  1672.   PicLen := PicHdl^^.PicSize;
  1673.  
  1674.   HLock(Handle(PicHdl));
  1675.   err := ZeroScrap;
  1676.   err := PutScrap(PicLen, 'PICT', Pointer(PicHdl^));
  1677.   HUnLock(Handle(PicHdl));
  1678.   KillPicture(QDPicture);
  1679.   KillPicture(PicHdl);
  1680. End;
  1681.  
  1682. {-----------------------------------------------------------------------------}
  1683.  
  1684. PROCEDURE InitThings;
  1685. Begin
  1686.   InitGraf(@thePort);          {create a grafport for the screen}
  1687.  
  1688.   MoreMasters;                 {extra pointer blocks at the bottom of the heap}
  1689.   MoreMasters;                 {this is 5 X 64 master pointers}
  1690.   MoreMasters;
  1691.   MoreMasters;
  1692.   MoreMasters;
  1693.  
  1694. {get the cursors we use and lock them down - no clutter}
  1695.   ClockCursor := GetCursor(watchCursor);
  1696.   HLock(Handle(ClockCursor));
  1697.  
  1698. {show the watch while we wait for inits & setups to finish}
  1699.   SetCursor(ClockCursor^^);
  1700.  
  1701. {init everything in case the app is the Startup App}
  1702.   InitFonts;                     {startup the fonts manager}
  1703.   InitWindows;                   {startup the window manager}
  1704.   InitMenus;                     {startup the menu manager}
  1705.   TEInit;                        {startup the text edit manager}
  1706.   InitDialogs(Nil);              {startup the dialog manager}
  1707.  
  1708. {set some global stuff}
  1709.   Finished := False;             {set program terminator to false}
  1710.   FlushEvents(everyEvent,0);     {clear events from previous program}
  1711. End;
  1712.  
  1713. {-----------------------------------------------------------------------------}
  1714.  
  1715. PROCEDURE SetupLimits;
  1716. Begin
  1717.   Screen := ScreenBits.Bounds;   {set the size of the screen}
  1718.   SetRect(DragArea,Screen.left+4,Screen.top+24,Screen.right-4,Screen.bottom-4);
  1719.   SetRect(GrowArea,Screen.left,Screen.top+24,Screen.right,Screen.bottom);
  1720. End;
  1721.  
  1722. {-----------------------------------------------------------------------------}
  1723.  
  1724. PROCEDURE SetupMenus;
  1725. Var  MenuTopic:   MenuHandle;
  1726.      NameHolder:  STR255;
  1727.      FoundIt:     Boolean;
  1728.      Item_No:     Integer;
  1729.      NumItems:    Integer;
  1730.      FontID:      Integer;
  1731.      useThisFont: Integer;
  1732.  
  1733. Begin
  1734.   MenuTopic := GetMenu(AppleMenu);  {get the apple desk accessories menu}
  1735.   AddResMenu(MenuTopic,'DRVR');     {adds all names into item list}
  1736.   InsertMenu(MenuTopic,0);          {put in list held by menu manager}
  1737.  
  1738.   MenuTopic := GetMenu(PrDlogMenu);
  1739.   InsertMenu(MenuTopic,0);
  1740.  
  1741.   MenuTopic := GetMenu(PrintMenu);
  1742.   InsertMenu(MenuTopic,0);
  1743.  
  1744.   MenuTopic := GetMenu(PrDrvrMenu);
  1745.   InsertMenu(MenuTopic,0);
  1746.  
  1747.   MenuTopic := GetMenu(FontMenu);
  1748.   AddResMenu(MenuTopic,'FONT');
  1749.   InsertMenu(MenuTopic,0);
  1750.  
  1751.   MenuTopic := GetMenu(StyleMenu);
  1752.   InsertMenu(MenuTopic,0);
  1753.  
  1754.   MenuTopic := GetMenu(PicScrMenu);
  1755.   InsertMenu(MenuTopic,0);
  1756.  
  1757. {check off the default font. If LaserWriter set to Helvetica}
  1758.   If theLaserW = GetStuff(PrRecordHdl^^.PrStl.wDev).b1
  1759.     then useThisFont := 20 {helvetica}
  1760.     else useThisFont := Geneva;
  1761.  
  1762.   MenuTopic := GetMenu(FontMenu);             {menu handle for fonts}
  1763.   NumItems := CountMItems(MenuTopic);         {number of fonts in menu}
  1764.   FoundIt := False;
  1765.   Item_No := 1;
  1766.   Repeat
  1767.     GetItem(MenuTopic, Item_No, NameHolder);    {get new font name}
  1768.     GetFNum(NameHolder, FontID);              {get the font ID}
  1769.     If FontID = useThisFont then              {is it same as default font??}
  1770.     begin
  1771.       PrevFontChked := Item_No;                 {save the new font No}
  1772.       CheckItem(MenuTopic, Item_No, True);        {check it off in menu}
  1773.       FoundIt := true;
  1774.     end;
  1775.     Item_No := Item_No + 1;
  1776.   Until (Item_No > NumItems) or FoundIt;
  1777.  
  1778. {check off the font style}
  1779.   MenuTopic := GetMenu(StyleMenu);             {menu handle for style}
  1780.   CheckItem(MenuTopic, 1, True);               {check the plain style}
  1781.  
  1782. {check off the size}
  1783.   CheckItem(MenuTopic, 10, True);              {check the 12 point}
  1784.  
  1785. {set the global guys}
  1786.   CurntFontID := FontID;   {the default font}
  1787.   CurntStyleID := [];      {plain}
  1788.   CurntSizeID := 12;       {size 12}
  1789.  
  1790. {because we didn't finish the code.... disable some menu items}
  1791.   MenuTopic := GetMHandle(PrDrvrMenu);
  1792.   DisableItem(MenuTopic, 5);      {write postscript sample}
  1793.  
  1794.   MenuTopic := GetMHandle(PrintMenu);
  1795.   DisableItem(MenuTopic, 11);     {trick polygon}
  1796.  
  1797. {now draw the menu bar}
  1798.   DrawMenuBar;           {all done so show the menu bar}
  1799. End;
  1800.  
  1801. {-----------------------------------------------------------------------------}
  1802.  
  1803. PROCEDURE SetupAWindow;
  1804. Begin
  1805.   aWindow := GetNewWindow(WindResID, Nil, Pointer(-1));
  1806. End;
  1807.  
  1808. {-----------------------------------------------------------------------------}
  1809.  
  1810. PROCEDURE SetupPrPort;
  1811. Var dummy: boolean;
  1812. Begin
  1813.   PrRecordHdl := THPrint(NewHandle(SizeOf(TPrint)));   {Make space for the record}
  1814.   PrOpen;                                              {open up ptr resource file}
  1815.   PrintDefault(PrRecordHdl);                           {fill rec w/default params}
  1816.   DefaltPage := PrRecordHdl^^.prInfoPT.rPage;          {default printer page size}
  1817. End;
  1818.  
  1819. {-----------------------------------------------------------------------------}
  1820.  
  1821. PROCEDURE SetUpThings;
  1822. Begin
  1823.   SetupLimits;
  1824.   SetupAWindow;
  1825.   SetupPrPort;
  1826.   SetupMenus;           {this order is important for checking items off}
  1827.  
  1828.   InitCursor;           {ready to go, so show the Arrow cursor}
  1829. End;
  1830.  
  1831. {-----------------------------------------------------------------------------}
  1832.  
  1833. PROCEDURE CloseThings;
  1834. Var PrChooser: LMwordPtr;
  1835. Begin
  1836. {make sure the Chooser is enabled upon leaving the App}
  1837.   PrChooser := LMwordPtr($946);       {set the address}
  1838.   GetStuff(PrChooser^).f15 := TRUE;   {set bit7 of $946}
  1839.   PrClose;
  1840. End;
  1841.  
  1842. {-----------------------------------------------------------------------------}
  1843.  
  1844. BEGIN
  1845.   InitThings;
  1846.   SetUpThings;
  1847.   MainEventLoop;
  1848.   CloseThings;
  1849. END.
  1850.